home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 February / EnigmA AMIGA RUN 15 (1997)(G.R. Edizioni)(IT)[!][issue 1997-02][PLANET CD V].iso / html / gpsoft / pub / dopus / dopus511.lha / dopus_pch.lha / ARexx.lha / Arexx / UnDMS.dopus5 < prev   
Text File  |  1995-06-10  |  4KB  |  138 lines
  1. /*
  2.   $VER: UnDMS.dopus5 1.4 (10.6.95)
  3.   Written by Edmund Vermeulen (edmundv@grafix.xs4all.nl). 
  4.  
  5.   ARexx script for Directory Opus 5 to unpack a DMS file to disk with
  6.   progress indication.
  7.  
  8.   To use it you may call it from the 'Double-click' function for the
  9.   'DiskMasher archive' filetype. Enter the following command:
  10.  
  11.   <ARexx> DOpus5:arexx/UnDMS.dopus5 {f} {Qp} CLOSE
  12.  
  13.   and set the 'Run asynchronously' flag.
  14.  
  15.   The optional CLOSE keyword will cause the lister to be closed immediately
  16.   instead of reading the directory.
  17. */
  18.  
  19. parse arg '"' dmsfile '"' portname cmd .
  20.  
  21. if portname='' then
  22.    portname='DOPUS.1'
  23. address value portname
  24.  
  25. cuthere=lastpos('/',dmsfile)
  26. if cuthere=0 then
  27.    cuthere=pos(':',dmsfile)
  28. dmsname="'"substr(dmsfile,cuthere+1)"'"
  29.  
  30. closecmd=(upper(cmd)='CLOSE')
  31.  
  32. options results
  33. lf='0a'x  /* ascii code for linefeed */
  34.  
  35. if ~show('l','rexxsupport.library') then
  36.    call addlib('rexxsupport.library',0,-30)
  37.  
  38. n=1
  39. dests=''
  40. drives='DF_0|DF_1|DF_2|DF_3'
  41.  
  42. /* check if these drives are really available */
  43.  
  44. do until drives=''
  45.    parse var drives drive '|' drives
  46.    devname=compress(drive,'_')
  47.    if showlist('h',devname) then do
  48.       dest.n=devname':'
  49.       dests=dests||drive'|'
  50.       n=n+1
  51.       end
  52.    end
  53.  
  54. /* RAD is always shown */
  55.  
  56. dest.n='RAD:'
  57. dests=dests'_RAD|'
  58.  
  59. dopus request '"Please insert disk in drive and then select'lf'destination for' dmsname'."' dests'Cancel'
  60. no=rc
  61. if no=0 then
  62.    exit
  63. if dest.no='RAD:'&~showlist('h','RAD') then
  64.    address command 'Mount RAD:'  /* automatically mount RAD: */
  65.  
  66. lister new
  67. handle=result
  68.  
  69. lister set handle busy on
  70. lister set handle path dest.no
  71. lister set handle progress 80 'Unpacking' dmsname'...'
  72. lister set handle title 'Unpacking' dmsname'...'
  73. lister refresh handle full  
  74.  
  75. /* wow! some clever stuff here... */
  76. address command 'Run >NIL: <NIL: DMS <NIL: >PIPE:dmsout WRITE "'dmsfile'" TO' dest.no 'NOTEXT'
  77. address command 'Status >T:ProcessNo COMMAND DMS'
  78. call open('temp','T:ProcessNo','r')
  79. process=readln('temp')
  80. close('temp')
  81. address command 'Delete >NIL: T:ProcessNo QUIET'
  82.  
  83. nomessage=1
  84. errorreport=''
  85. buffer=''
  86. call open('dmsout','PIPE:dmsout','r')    /* output from DMS comes through PIPE: */
  87.  
  88. do until eof('dmsout')
  89.    buffer=buffer||readch('dmsout',25)    /* read portions of 25 characters */
  90.    here=verify(buffer,'0a0d'x,'m')    /* check for new lines */
  91.    if here>0 then do
  92.       line=left(buffer,here-1)        /* one whole line */
  93.       if nomessage&left(line,7)='No Disk' then do
  94.          lister set handle progress name 'Insert disk in' strip(dest.no,'t',':')
  95.          nomessage=0
  96.          end
  97.       parse var line ' ' line        /* get rid of some ugly stuff */
  98.       buffer=substr(buffer,here+1)
  99.       if pos('ERROR',upper(line))>0 then do
  100.          errorreport=errorreport||lf||line
  101.          command beep
  102.          end
  103.       if pos('unPacking',line)>0 then do
  104.          track=right(line,2)
  105.          lister set handle progress count track+1
  106.          lister set handle progress name 'Track' track
  107.          lister query handle abort
  108.          if result then do
  109.             address command 'Break' process 'C'
  110.             if closecmd then do
  111.                lister set handle busy off
  112.                lister close handle
  113.                end
  114.             else do
  115.                lister set handle title 'UnDMS aborted...'
  116.                lister refresh handle full
  117.                lister set handle title  /* reset title */
  118.                lister set handle busy off
  119.                end
  120.             exit
  121.             end
  122.          end
  123.       end
  124.    end
  125.  
  126. call close('dmsout')
  127.  
  128. if errorreport~=='' then
  129.    dopus request '"Error Report'lf||errorreport'" OK'
  130.  
  131. lister set handle title  /* reset title */
  132. lister set handle busy off
  133.  
  134. if closecmd then
  135.    lister close handle
  136. else
  137.    lister read handle dest.no force
  138.